home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / attrbar.tcl < prev    next >
Encoding:
Text File  |  1997-04-09  |  13.9 KB  |  358 lines

  1. ##############################################################################
  2. # $Id: attrbar.tcl,v 1.2 1997/04/09 13:12:59 stewart Exp $
  3. #
  4. # attrbar.tcl - attribute icon bar under menus
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:fill_font_menu {menu} {
  26.     global vTcl
  27.     set fams [font families]
  28.     foreach i $fams {
  29.         $menu add radiobutton -label $i -variable vTcl(w,font) \
  30.         -value $i -command "vTcl:set_font base \$vTcl(w,widget) \{$i\}"
  31.     }
  32. }
  33.  
  34. proc vTcl:fill_fontsize_menu {menu} {
  35.     global vTcl
  36.     foreach i {8 9 10 11 12 14 18 24 36 48 72} {
  37.         $menu add radiobutton -label $i -variable vTcl(w,font) \
  38.         -value $i -command "vTcl:set_font size \$vTcl(w,widget) $i"
  39.     }
  40.     $menu add separator
  41.     $menu add command -label other
  42. }
  43.  
  44. proc vTcl:set_justify {widget option} {
  45.     catch {
  46.         $widget conf -justify $option
  47.     }
  48. }
  49.  
  50. proc vTcl:set_font {which widget option} {
  51.     global vTcl
  52.     if [catch {set was [$widget cget -font]}] {return}
  53.     set base [lindex $was 0]
  54.     set size [lindex $was 1]
  55.     set style [lindex $was 2]
  56.     switch $which {
  57.         base {
  58.             $widget conf -font [list $option $size $style]
  59.         }
  60.         size {
  61.             $widget conf -font [list $base $option $style]
  62.         }
  63.         style {
  64.             set style ""
  65.             foreach i {bold italic underline} {
  66.                 if $vTcl(w,fontstyle,$i) {
  67.                     lappend style $i
  68.                 }
  69.             }
  70.             $widget conf -font [list $base $size $style]
  71.         }
  72.     }
  73. }
  74.  
  75. proc vTcl:widget_set_relief {relief} {
  76.     global vTcl
  77.     if {$vTcl(w,widget) == ""} {return}
  78.     if [catch {$vTcl(w,widget) cget -relief}] {return}
  79.     $vTcl(w,widget) conf -relief $relief
  80. }
  81.  
  82. proc vTcl:widget_set_border {border} {
  83.     global vTcl
  84.     if {$vTcl(w,widget) == ""} {return}
  85.     if [catch {$vTcl(w,widget) cget -bd}] {return}
  86.     $vTcl(w,widget) conf -bd $border
  87. }
  88.  
  89. proc vTcl:widget_set_anchor {anchor} {
  90.     global vTcl
  91.     if {$vTcl(w,widget) == ""} {return}
  92.     if [catch {$vTcl(w,widget) cget -anchor}] {return}
  93.     $vTcl(w,widget) conf -anchor $anchor
  94. }
  95.  
  96. proc vTcl:widget_set_fg {target} {
  97.     global vTcl
  98.     if {$vTcl(w,widget) == ""} {return}
  99.     if [catch {set fg [$vTcl(w,widget) cget -foreground]}] {return}
  100.     set vTcl(w,opt,-foreground) $fg
  101.     vTcl:show_color $target -foreground vTcl(w,opt,-foreground)
  102. }
  103.  
  104. proc vTcl:widget_set_bg {target} {
  105.     global vTcl
  106.     if {$vTcl(w,widget) == ""} {return}
  107.     if [catch {set bg [$vTcl(w,widget) cget -background]}] {return}
  108.     set vTcl(w,opt,-background) $bg
  109.     vTcl:show_color $target -background vTcl(w,opt,-background)
  110. }
  111.  
  112. proc vTcl:set_manager {mgr} {
  113.     global vTcl
  114.     foreach i $vTcl(w,mgrs) {
  115.         if { $i == $mgr } { 
  116.             $vTcl(mgrs,$i,widget) configure -relief sunken
  117.         } else {
  118.             $vTcl(mgrs,$i,widget) configure -relief raised
  119.         }
  120.     }
  121.     set vTcl(w,def_mgr) $mgr
  122. }
  123.  
  124. proc vTcl:attrbar_color {target} {
  125.     set dbg [lindex [. conf -bg] 3]
  126.     if {[catch {set fg [$target cget -fg]}] == 1} {
  127.         set fg $dbg
  128.     } else {
  129.         set fg [$target cget -fg]
  130.     }
  131.     if {[catch {set bg [$target cget -bg]}] == 1} {
  132.         set fg $dbg
  133.     } else {
  134.         set bg [$target cget -bg]
  135.     }
  136.     catch {
  137.         .vTcl.attr.010.lab41 conf -bg $fg
  138.         .vTcl.attr.010.lab42 conf -bg $bg
  139.     }
  140. }
  141.  
  142. proc vTcl:attrbar {args} {
  143.     global vTcl tk_version
  144.     set base .vTcl
  145.     frame .vTcl.attr \
  146.         -borderwidth 1 -height 30 -relief sunken -width 30 
  147.     pack .vTcl.attr \
  148.         -expand 1 -fill x -side top 
  149.     frame .vTcl.attr.01 \
  150.         -borderwidth 1 -height 20 -relief raised -width 20 
  151.     pack .vTcl.attr.01 \
  152.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 3 -pady 2 \
  153.         -side left 
  154.     entry .vTcl.attr.01.02 \
  155.         -highlightthickness 0 -width 15 -textvariable vTcl(w,opt,-text)
  156.     bind .vTcl.attr.01.02 <Return> {
  157.         .vTcl.attr.01.02 insert end "\n"
  158.         vTcl:update_label $vTcl(w,widget)
  159.     }
  160.     bind .vTcl.attr.01.02 <KeyRelease> {
  161.         vTcl:update_label $vTcl(w,widget)
  162.     }
  163.     vTcl:set_balloon .vTcl.attr.01.02 "text"
  164.     pack .vTcl.attr.01.02 \
  165.         -anchor center -expand 1 -fill both -padx 2 -pady 2 -side left
  166.     button .vTcl.attr.01.03 \
  167.         -highlightthickness 0 -bd 1 -padx 4 -pady 1 -image ellipses -command {
  168.             vTcl:set_command $vTcl(w,widget)
  169.         }
  170.     vTcl:set_balloon .vTcl.attr.01.03 "command"
  171.     pack .vTcl.attr.01.03 \
  172.         -anchor center -padx 2 -pady 2 -side left
  173.  
  174.     frame .vTcl.attr.04 \
  175.         -borderwidth 1 -height 20 -relief raised -width 20 
  176.     pack .vTcl.attr.04 \
  177.         -anchor center -expand 0 -fill none -padx 3 -pady 2 -side left
  178.     menubutton .vTcl.attr.04.relief -bd 1 -relief raised -image relief \
  179.         -highlightthickness 0 -menu .vTcl.attr.04.relief.m
  180.     menu .vTcl.attr.04.relief.m -tearoff 0
  181.     .vTcl.attr.04.relief.m add radiobutton -image rel_raised -command {
  182.         vTcl:widget_set_relief raised
  183.     } -variable vTcl(w,opt,-relief) -value raised
  184.     .vTcl.attr.04.relief.m add radiobutton -image rel_sunken -command {
  185.         vTcl:widget_set_relief sunken
  186.     } -variable vTcl(w,opt,-relief) -value sunken
  187.     .vTcl.attr.04.relief.m add radiobutton -image rel_groove -command {
  188.         vTcl:widget_set_relief groove
  189.     } -variable vTcl(w,opt,-relief) -value groove
  190.     .vTcl.attr.04.relief.m add radiobutton -image rel_ridge -command {
  191.         vTcl:widget_set_relief ridge
  192.     } -variable vTcl(w,opt,-relief) -value ridge
  193.     .vTcl.attr.04.relief.m add separator
  194.     .vTcl.attr.04.relief.m add radiobutton -label "none" -command {
  195.         vTcl:widget_set_relief flat
  196.     } -variable vTcl(w,opt,-relief) -value flat
  197.     vTcl:set_balloon .vTcl.attr.04.relief "border"
  198.     menubutton .vTcl.attr.04.border -bd 1 -relief raised -image border \
  199.         -highlightthickness 0 -menu .vTcl.attr.04.border.m
  200.     menu .vTcl.attr.04.border.m -tearoff 0
  201.     .vTcl.attr.04.border.m add radiobutton -label 1 -command {
  202.         vTcl:widget_set_border 1
  203.     } -variable vTcl(w,opt,-borderwidth) -value 1
  204.     .vTcl.attr.04.border.m add radiobutton -label 2 -command {
  205.         vTcl:widget_set_border 2
  206.     } -variable vTcl(w,opt,-borderwidth) -value 2
  207.     .vTcl.attr.04.border.m add radiobutton -label 3 -command {
  208.         vTcl:widget_set_border 3
  209.     } -variable vTcl(w,opt,-borderwidth) -value 3
  210.     .vTcl.attr.04.border.m add radiobutton -label 4 -command {
  211.         vTcl:widget_set_border 4
  212.     } -variable vTcl(w,opt,-borderwidth) -value 4
  213.     .vTcl.attr.04.border.m add separator
  214.     .vTcl.attr.04.border.m add radiobutton -label none -command {
  215.         vTcl:widget_set_border 0
  216.     } -variable vTcl(w,opt,-borderwidth) -value 0
  217.     vTcl:set_balloon .vTcl.attr.04.border "border width"
  218.     menubutton .vTcl.attr.04.anchor -bd 1 -relief raised -image anchor \
  219.         -highlightthickness 0 -menu .vTcl.attr.04.anchor.m
  220.     menu .vTcl.attr.04.anchor.m -tearoff 0
  221.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_c -command {
  222.         vTcl:widget_set_anchor center
  223.     } -variable vTcl(w,opt,-anchor) -value center
  224.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_n -command {
  225.         vTcl:widget_set_anchor n
  226.     } -variable vTcl(w,opt,-anchor) -value n
  227.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_s -command {
  228.         vTcl:widget_set_anchor s
  229.     } -variable vTcl(w,opt,-anchor) -value s
  230.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_e -command {
  231.         vTcl:widget_set_anchor e
  232.     } -variable vTcl(w,opt,-anchor) -value e
  233.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_w -command {
  234.         vTcl:widget_set_anchor w
  235.     } -variable vTcl(w,opt,-anchor) -value w
  236.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_nw -command {
  237.         vTcl:widget_set_anchor nw
  238.     } -variable vTcl(w,opt,-anchor) -value nw
  239.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_ne -command {
  240.         vTcl:widget_set_anchor ne
  241.     } -variable vTcl(w,opt,-anchor) -value ne
  242.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_sw -command {
  243.         vTcl:widget_set_anchor sw
  244.     } -variable vTcl(w,opt,-anchor) -value sw
  245.     .vTcl.attr.04.anchor.m add radiobutton -image anchor_se -command {
  246.         vTcl:widget_set_anchor se
  247.     } -variable vTcl(w,opt,-anchor) -value se
  248.     vTcl:set_balloon .vTcl.attr.04.anchor "label anchor"
  249.     pack .vTcl.attr.04.relief -side left -padx 2 -pady 2
  250.     pack .vTcl.attr.04.border -side left -padx 2 -pady 2
  251.     pack .vTcl.attr.04.anchor -side left -padx 2 -pady 2
  252.  
  253.     frame .vTcl.attr.010 \
  254.         -borderwidth 1 -height 20 -relief raised -width 20 
  255.     pack .vTcl.attr.010 \
  256.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 3 -pady 2 \
  257.         -side left 
  258.     button .vTcl.attr.010.lab41 \
  259.         -bd 1 -image fg -pady 3 -padx 2 -highlightthickness 0 -command {
  260.             vTcl:widget_set_fg .vTcl.attr.010.lab41
  261.         }
  262.     vTcl:set_balloon .vTcl.attr.010.lab41 "foreground"
  263.     pack .vTcl.attr.010.lab41 \
  264.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  265.         -side left 
  266.     button .vTcl.attr.010.lab42 \
  267.         -bd 1 -pady 3 -image bg -padx 2 -highlightthickness 0 -command {
  268.             vTcl:widget_set_bg .vTcl.attr.010.lab42
  269.         }
  270.     vTcl:set_balloon .vTcl.attr.010.lab42 "background"
  271.     pack .vTcl.attr.010.lab42 \
  272.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  273.         -side left 
  274.  
  275.     # Font Browsing in tk8.0 or later
  276.     #
  277.     if {$tk_version >= 8} {
  278.  
  279.     frame .vTcl.attr.011 \
  280.         -borderwidth 1 -height 20 -relief raised -width 20 
  281.     pack .vTcl.attr.011 \
  282.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 3 -pady 2 \
  283.         -side left 
  284.     menubutton .vTcl.attr.011.lab41 \
  285.         -bd 1 -relief raised -image fontbase -pady 3 -padx 2 \
  286.         -highlightthickness 0 -menu .vTcl.attr.011.lab41.m
  287.     menu .vTcl.attr.011.lab41.m -tearoff 0
  288.     vTcl:fill_font_menu .vTcl.attr.011.lab41.m
  289.     vTcl:set_balloon .vTcl.attr.011.lab41 "font"
  290.     menubutton .vTcl.attr.011.lab42 \
  291.         -bd 1 -relief raised -image fontsize -pady 3 -padx 2 \
  292.         -highlightthickness 0 -menu .vTcl.attr.011.lab42.m
  293.     menu .vTcl.attr.011.lab42.m -tearoff 0
  294.     vTcl:fill_fontsize_menu .vTcl.attr.011.lab42.m
  295.     vTcl:set_balloon .vTcl.attr.011.lab42 "font size"
  296.     menubutton .vTcl.attr.011.lab43 \
  297.         -bd 1 -relief raised -image fontstyle -pady 3 -padx 2 \
  298.         -highlightthickness 0 -menu .vTcl.attr.011.lab43.m
  299.     menu .vTcl.attr.011.lab43.m -tearoff 0
  300.     .vTcl.attr.011.lab43.m add check -variable vTcl(w,fontstyle,bold) \
  301.         -label bold -command "vTcl:set_font style \$vTcl(w,widget) bold"
  302.     .vTcl.attr.011.lab43.m add check -variable vTcl(w,fontstyle,italic) \
  303.         -label italic -command "vTcl:set_font style \$vTcl(w,widget) italic"
  304.     .vTcl.attr.011.lab43.m add check -variable vTcl(w,fontstyle,underline) \
  305.         -label underline -comm "vTcl:set_font style \$vTcl(w,widget) underline"
  306.     vTcl:set_balloon .vTcl.attr.011.lab43 "font style"
  307.     menubutton .vTcl.attr.011.lab44 \
  308.         -bd 1 -relief raised -image justify -pady 3 -padx 2 \
  309.         -highlightthickness 0 -menu .vTcl.attr.011.lab44.m
  310.     menu .vTcl.attr.011.lab44.m -tearoff 0
  311.     .vTcl.attr.011.lab44.m add radiobutton -variable vTcl(w,opt,-justify) \
  312.         -label left -command "vTcl:set_justify \$vTcl(w,widget) left"
  313.     .vTcl.attr.011.lab44.m add radiobutton -variable vTcl(w,opt,-justify) \
  314.         -label center -command "vTcl:set_justify \$vTcl(w,widget) center"
  315.     .vTcl.attr.011.lab44.m add radiobutton -variable vTcl(w,opt,-justify) \
  316.         -label right -command "vTcl:set_justify \$vTcl(w,widget) right"
  317.     vTcl:set_balloon .vTcl.attr.011.lab44 "justification"
  318.     pack .vTcl.attr.011.lab41 .vTcl.attr.011.lab42 .vTcl.attr.011.lab43 \
  319.         .vTcl.attr.011.lab44 \
  320.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  321.         -side left 
  322.  
  323.     }
  324.  
  325.     frame .vTcl.attr.016 \
  326.         -borderwidth 1 -height 20 -relief raised -width 20 
  327.     pack .vTcl.attr.016 \
  328.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 3 -pady 2 \
  329.         -side left 
  330.     set vTcl(mgrs,grid,widget) .vTcl.attr.016.017
  331.     button .vTcl.attr.016.017 \
  332.         -command {vTcl:set_manager grid} \
  333.         -highlightthickness 0 -image mgr_grid -padx 0 -pady 0 
  334.     vTcl:set_balloon .vTcl.attr.016.017 "use grid manager"
  335.     pack .vTcl.attr.016.017 \
  336.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  337.         -side left 
  338.     set vTcl(mgrs,pack,widget) .vTcl.attr.016.018
  339.     button .vTcl.attr.016.018 \
  340.         -command {vTcl:set_manager pack} \
  341.         -highlightthickness 0 -image mgr_pack -padx 0 -pady 0 
  342.     vTcl:set_balloon .vTcl.attr.016.018 "use packer manager"
  343.     pack .vTcl.attr.016.018 \
  344.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  345.         -side left 
  346.     set vTcl(mgrs,place,widget) .vTcl.attr.016.019
  347.     button .vTcl.attr.016.019 \
  348.         -command {vTcl:set_manager place} \
  349.         -highlightthickness 0 -image mgr_place -padx 0 -pady 0 
  350.     vTcl:set_balloon .vTcl.attr.016.019 "use place manager"
  351.     pack .vTcl.attr.016.019 \
  352.         -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 2 -pady 2 \
  353.         -side left 
  354.     set vTcl(mgrs,wm,widget) .vTcl.attr.016.020
  355.     button .vTcl.attr.016.020
  356. }
  357.  
  358.